#
# Package.
#

package iSOCK::Model::Product;

#
# Dependencies.
#

use Algorithm::Diff qw( traverse_sequences );
use HTML::Entities qw( encode_entities );
use SOCK::BOT qw( like_dr_tag ); # >= v3.27.0_04
use SOCK::SVN::Product;

#
# Parent.
#

use Moose;
use namespace::autoclean;

BEGIN { extends 'iSOCK::Model::Root' }

#
# Documentation.
#

=head1 NAME

iSOCK::Model::Product - Catalyst Model

=head1 DESCRIPTION

Catalyst Model.

=head1 AUTHOR

Xavier Caron

=head1 LICENSE

This library is free software. You can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

#
# Subs.
#

sub to_abstract {
  my ( $self, $option ) = @_;
  
  my $session = $option->{c}->session;
  
  if ( $self->_spawn ({ tool => 'sock_spirit_to_abstract', c => $option->{c}, log => $option->{log} }) ) {
    my $stem = $session->{mif_stem};
    
    $session->{abstract_file} = "5_HTML_out/$stem.html";
    $session->{diagram_file}  = "5_HTML_out/$stem.svg";
    $session->{htmls_ball}    = "$stem-HTMLs.tar.bz2";
    
    return 1;
  }
  else {
    delete $session->{$_} for qw( abstract_file diagram_file htmls_ball );
  }
  
  return;
}

sub to_api {
  my ( $self, $option ) = @_;
  
  my $session    = $option->{c}->session;
  my $parameters = $option->{c}->request->parameters;
  
  if ( $self->_spawn ({ tool => 'sock_spirit_to_api', options => ' --tarball', c => $option->{c}, log => $option->{log} }) ) {
    my $stem = $session->{mif_stem};
    
    $session->{api_h_file}   = "5_API_out/$stem.h";
    $session->{api_hi_file}  = "5_API_out/$stem-integration.h";
    $session->{api_vi_file}  = "5_API_out/$stem-integration.v";
    $session->{api_inc_file} = "5_API_out/$stem.inc";
    $session->{api_ddf_file} = "5_API_out/IO$stem.ddf";
    $session->{api_svd_file} = "5_API_out/$stem.svd";
    $session->{api_tcl_file} = "5_API_out/$stem.tcl";
    $session->{api_ball}     = "$stem-API.tar.bz2";
    
    return 1;
  }
  else {
    delete $session->{$_} for qw( api_h_file api_hi_file api_vi_file api_inc_file api_ddf_file api_svd_file api_tcl_file api_ball );
  }
  
  return;
}

sub annotate_datasheets {
  my ( $self, $option ) = @_;
  
  my $session = $option->{c}->session;
  
  if ( $self->_spawn ({ tool => 'sock_annotate_datasheets', options => ( exists $ENV{ISOCK_PARALLEL} ? "--parallel $ENV{ISOCK_PARALLEL}" : '' ), c => $option->{c}, log => $option->{log} }) ) {
    my $stem = $session->{mif_stem};
    
    $session->{annotated_mifs_ball} = "$stem-aMIFs.zip";
    
    return 1;
  }
  else {
    delete $session->{$_} for qw( annotated_mifs_ball );
  }
  
  return;
}

sub to_diagram {
  my ( $self, $option ) = @_;
  
  my $session = $option->{c}->session;
  
  if ( $self->_spawn ({ tool => 'sock_spirit_to_diagram', c => $option->{c}, log => $option->{log} }) ) {
    my $stem = $session->{mif_stem};
    
    $session->{diagram_file} = "5_HTML_out/$stem.svg";
    
    return 1;
  }
  else {
    delete $session->{$_} for qw( diagram_file );
  }
  
  return;
}

sub to_pio_sheet {
  my ( $self, $option ) = @_;
  
  my $session = $option->{c}->session;
  
  if ( $self->_spawn ({ tool => 'sock_spirit_to_pio_sheet', options => '--fetch_local_spirits', c => $option->{c}, log => $option->{log} }) ) {
    my $stem = $session->{mif_stem};
    
    $session->{pio_sheet_file} = "$stem-PIO_sheet.xls";
    
    return 1;
  }
  else {
    delete $session->{$_} for qw( pio_sheet_file );
  }
  
  return;
}

sub to_followup {
  my ( $self, $option ) = @_;
  
  my $session    = $option->{c}->session;
  my $parameters = $option->{c}->request->parameters;
  
  my $options = 
    ( $parameters->{re_include} ? " --re_include '" . $parameters->{re_include} . "'" : '' )
  . ( $parameters->{re_exclude} ? " --re_exclude '" . $parameters->{re_exclude} . "'" : '' )
  ;
  
  if ( $self->_spawn ({ tool => 'sock_spirit_to_followup', options => $options, c => $option->{c}, log => $option->{log} }) ) {
    my $stem = $session->{mif_stem};
    
    $session->{followup_template_file} = "$stem-template.xls";
    
    return 1;
  }
  else {
    delete $session->{$_} for qw( followup_template_file );
  }
  
  return;
}

sub to_verilog_pios {
  my ( $self, $option ) = @_;
  
  my $session      = $option->{c}->session;
  my $session_path = $session->{session_path};
  
  if ( $self->_spawn ({ tool => 'sock_spirit_to_verilog_pios', c => $option->{c}, log => $option->{log} }) ) {
    my $stem = $session->{mif_stem};
    
    $session->{verilog_pios_file}  = "5_HDL_out/$stem-PIOs.v";
    $session->{verilog_pios_files} = [ map { s/^$session_path\/// ; $_ } grep { ! m/-PIOs/ } glob "$session_path/5_HDL_out/$stem-PIO?.v" ];
    
    return 1;
  }
  else {
    delete $session->{$_} for qw( verilog_pios_file verilog_pios_files );
  }
  
  return;
}

sub to_tcl {
  my ( $self, $option ) = @_;
  
  my $session      = $option->{c}->session;
  my $session_path = $session->{session_path};
  
  if ( $self->_spawn ({ tool => 'sock_spirit_to_tcl', c => $option->{c}, log => $option->{log} }) ) {
    my $stem = $session->{mif_stem};
    
    $session->{tcl_file} = "5_API_out/$stem.tcl";
    
    return 1;
  }
  else {
    delete $session->{$_} for qw( tcl_file );
  }
  
  return;
}

sub _spawn {
  my ( $self, $option ) = @_;
  
  my $session = $option->{c}->session;
  
  no warnings 'uninitialized';
  
  my $command = "$option->{tool}" . ( $session->{spirit_file} ? " --spirit $session->{spirit_file}" : "" ) . " --indent 2 --file_indent 0 $option->{options}";
  
  $self->SUPER::spawn ( $option->{c}, $command, $option->{log} );
}

sub repository_revision {
  my ( $self, $option ) = @_;
  
  if ( my $svn = SOCK::SVN::Product->new ({ svn_pipeless => 1, svn_tmp => $option->{c}->session->{session_path} }) ) {
    return $svn->revision;
  }
  
  return;
}

sub diff {
  my ( $self, $option ) = @_;
  
  my ( $c, $svn_product, $old_tag, $new_tag, $view, $has_api_files ) = map { $option->{$_} } qw( c svn_product old_tag new_tag view has_api_files );
  
  return unless $svn_product; # FIXME understand why test number 10 fails
  
  my $session = $c->session;
  
  if ( $has_api_files && !defined $old_tag && !defined $new_tag ) {
    $old_tag = $new_tag = 'current';
  }
  
  return if ( $old_tag eq '-' || $new_tag eq '-' ); # || ( $old_tag eq $new_tag )
  
  my $session_id     = $c->sessionid;
  my $session_path   = $self->session_path ( $c );
  
  my $view_directory = '5_API_out';
  my $view_file      = $svn_product . '.' . ( $view ? lc $view : 'h' );
  
  my $old_directory  = "$session_path/" . ( $old_tag && $old_tag ne 'current' ? "$svn_product/$view_directory,$old_tag" : $view_directory );
  my $new_directory  = "$session_path/" . ( $new_tag && $new_tag ne 'current' ? "$svn_product/$view_directory,$new_tag" : $view_directory );

  my $svn            = SOCK::SVN::Product->new;
  
  my $error          = sub { $c->stash ( body => "<p class=\"error\">ERROR! $_[0]</p>" ) };

  my $old_directory_is_there;

  if ( -d $old_directory ) {
    $old_directory_is_there = 1;
  }
  else {
    if ( $svn->export ({ url => $svn->url ({ name => $svn_product, tag => $old_tag, view => 'integration', file => $view_directory }), options => $old_directory }) ) {
      $old_directory_is_there = 1;
    }
  }

  if ( $old_directory_is_there ) {
    my $new_directory_is_there;
    
    if ( -d $new_directory ) {
      $new_directory_is_there = 1;
    }
    else {
      if ( $svn->export ({ url => $svn->url ({ name => $svn_product, tag => $new_tag, view => 'integration', file => $view_directory }), options => $new_directory }) ) {
        $new_directory_is_there = 1;
      }
    }
    
    if ( $new_directory_is_there ) {
      my $old_file = "$old_directory/$view_file";
      my $new_file = "$new_directory/$view_file";
      
      #
      # Legacy.
      #
      
      if ( !-f $old_file && $svn_product =~ /^AT91/ ) {
        ( my $file = $view_file ) =~ s/^AT91//;
        
        $old_file = "$old_directory/$file";
      }
      if ( !-f $new_file && $svn_product =~ /^AT91/ ) {
        ( my $file = $view_file ) =~ s/^AT91//;
        
        $new_file = "$new_directory/$file";
      }

      #
      # Body.
      #

      if ( open my $fh_old, '<', $old_file ) {
        if ( open my $fh_new, '<', $new_file ) {
          my $body = "<div class=\"diff\" id=\"top\"><code>\n";

          my $olds = [ map { chomp ; $_ } <$fh_old> ];
          my $news = [ map { chomp ; $_ } <$fh_new> ];

          #
          # Diff.
          #

          my @ids;
          my $number = 1;
          my $bwaah = sub {
            my ( $kind ) = @_;

            my $l    = sprintf '%5d',  $number;
            my $line = "<span class=\"line\">$l</span>";

            if ( $kind ) {
              my $n     = sprintf '%05d', $number;

              my $label = ( $kind eq '-' ? '-' : '+' ) . $n;
              my $id    = ( $kind eq '-' ? 'm' : 'p' ) . $n;

              my $daah  = { kind => $kind, number => $number, line => $line, label => $label, id => $id };

              push @ids, $daah;

              $number++ if $kind eq '+';

              return $daah;
            }
            else {
              $number++;

              return { line => $line };
            }
          };

          traverse_sequences ( $olds, $news, {
            MATCH     => sub { my $h = $bwaah->(     ) ; $body .="$h->{line} "                                     . encode_entities ( $olds->[ shift        ] ) .       "\n" },
            DISCARD_A => sub { my $h = $bwaah->( '-' ) ; $body .="$h->{line} <del class=\"less\" id=\"$h->{id}\">" . encode_entities ( $olds->[ shift        ] ) . "</del>\n" },
            DISCARD_B => sub { my $h = $bwaah->( '+' ) ; $body .="$h->{line} <ins class=\"more\" id=\"$h->{id}\">" . encode_entities ( $news->[ shift, shift ] ) . "</ins>\n" },
          } );

          $body .="</code></div>\n";

          #
          # Tags.
          #

          my @tags = grep { like_dr_tag ( $_ ) } sort map { $_->name } $c->model ( 'App::SpecificationTag' )->search ({ owner => $svn_product });
          
          unshift @tags, 'current' if $has_api_files;

          $c->stash ( old_tags => \@tags, new_tags => \@tags, current => { product => $svn_product, old_tag => $old_tag, new_tag => $new_tag } );

          #
          # Navigation.
          #

          if ( @ids ) {
            my @diffs = _reduced_diffs ( @ids );
            
            $c->stash ( body => $body, alt_navigation => ( scalar @diffs ? 1 : undef ), alt_navigation_title => "Diffs", alt_navigation_items => \@diffs );
          }
          else {
            $c->stash ( body => $body );
          }
        }
        else {
          $error->( "Could not open new API file!" );
        }
      }
      else {
        $error->( "Could not open old API file!" );
      }
    }
    else {
      $error->( "Could not checkout new file!" );
    }
  }
  else {
    $error->( "Could not checkout old file!" );
  }
  
  return;
}

sub _reduced_diffs {
  my $opposite = sub { return ( $_[0] eq '-' && $_[1] eq '+' ) || ( $_[0] eq '+' && $_[1] eq '-' ); };
  
  my @diffs = ( { id => 'top', label => 'top' } );

  {
    my ( $last_kind, $last_number ) = ( '?', 0 );

    for ( @_ ) {
      push @diffs, $_ unless $_->{kind} eq $last_kind && $_->{number} - 1 == $last_number;

      ( $last_kind, $last_number ) = ( $_->{kind}, $_->{number} );
    }
  }
  
  my @unique_diffs;

  {
    my ( $last_kind, $last_number ) = ( '?', 0 );

    for ( @diffs ) {
      if ( !$last_number ) {
        push @unique_diffs, $_;
      }
      else {
        unless ( $_->{number} == $last_number && $_->{kind} eq $last_kind ) {
          push @unique_diffs, $_;
        }
      }

      ( $last_kind, $last_number ) = ( $_->{kind}, $_->{number} );
    }
  }

  my @compacted_diffs;

  {
    my ( $last_kind, $last_number ) = ( '?', 0 );

    for ( @unique_diffs ) {
      if ( !$last_number ) {
        push @compacted_diffs, $_;
      }
      else {
        if ( $_->{number} == $last_number && $opposite->( $last_kind, $_->{kind} ) ) {
          my $h = pop @compacted_diffs;

          $h->{label} =~ s/^./&plusmn;/;

          push @compacted_diffs, $h;
        }
        else {
          push @compacted_diffs, $_;
        }
      }

      ( $last_kind, $last_number ) = ( $_->{kind}, $_->{number} );
    }
  }
  
  @compacted_diffs;
}

sub vs_product {
  my ( $self, $option ) = @_;
  
  if ( $self->_spawn ({ tool => 'sock_product_vs_product', options => $option->{options}, c => $option->{c}, log => $option->{log} }) ) {
    return 1;
  }
  
  return;
}

sub session_keys { # FIXME what about ( last_svn_product, process_followup, process_specification, product_library, product_name, product_vendor, product_version, svn_product, svn_tag ) keys?
  qw(
    abstract_file
    annotated_mifs_ball
    api_ball
    api_ddf_file
    api_h_file
    api_hi_file
    api_inc_file
    api_svd_file
    api_tcl_file
    api_vi_file
    big_zip_ball
    diagram_file
    followup_template_file
    htmls_ball
    pio_sheet_file
    tcl_file
    verilog_pios_file
    verilog_pios_files
  );
}

#
# True.
#

1;
